home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1993…stman Always Clicks Twice / ADC Developer CD (1993-01) (''The Postman Always Clicks Twice'')_iso / Dev.CD 199301.iso / Development Platforms / LISP Related / LISP Goodies / matt's utils 8sept / object-fred-dialog-item.lisp < prev    next >
Encoding:
Text File  |  1992-09-07  |  26.0 KB  |  670 lines  |  [TEXT/CCL2]
  1. ;;;
  2. ;;; object-fred-dialog-item.lisp
  3. ;;;
  4.  
  5. #|
  6. ================================================================
  7. Purpose ========================================================
  8. ================================================================
  9. Defines the object-fred-dialog-item subclass of fred-dialog-item that
  10. incorporates embedded objects.
  11.  
  12. We care about these conditions:
  13.  
  14. Object text is selected. (Must extend selection.)
  15.   Happens via mouse, keystrokes, or programmatically. Ignore latter for now
  16.   (fix?).
  17.  
  18. Object text is deleted.  (Must delete object entry.)
  19.   Happens via keystrokes or programmatically. Ignore latter for now (fix?).
  20.  
  21.  
  22. ==== To use this file ====
  23. (Note: Generic functions specify the interface.)
  24.  
  25. This file defines the object-fred-dialog-item subclass of
  26. fred-dialog-item, which knows how to display strings and non-string
  27. objects. Strings are displayed in the font specified by
  28. object-fred-dialog-item's font-spec-string slot, and non-string objects
  29. are displayed as specified by the font-spec-non-string slot.
  30.  
  31. To edit a list of strings and non-string objects create a
  32. object-fred-dialog-item instance and call edit-l-data on it and the data
  33. to be initially edited. In all cases the "data" involved is a list of
  34. strings and non-string objects. Non-string objects are converted to
  35. strings via string-from-object, which you can redefine. You can call
  36. add-link to add new objects. Three functions return data in
  37. object-fred-dialog-items: l-str-obj-ofdi (returns all items),
  38. l-str-obj-ofdi-selected (returns selected items), and
  39. l-str-obj-ofdi-in-range (returns items in a range).
  40.  
  41.  
  42. ================================================================
  43. Status =========================================================
  44. ================================================================
  45. Usable.
  46.  
  47. Copyright © 1990-92 Matthew Cornell. All Rights Reserved. Send
  48. bugs, comments, questions, and fixes to cornell@cs.umass.edu.
  49.  
  50. Undo not implemented.
  51.  
  52. Changing font-spec-string and font-spec-non-string after creating
  53. doesn't change the current display.
  54.  
  55. Not all font-setting functions stopped (e.g. buffer-set-font-spec) so it's
  56. possible our pretty font scheme might be messed up.
  57.  
  58. Bug: auto-fill.lisp calls buffer-char-replace and buffer-insert which I
  59. don't advise.
  60.  
  61.  
  62. ================================================================
  63. Change history =================================================
  64. ================================================================
  65. 29-Jul-92 mc    Created.
  66. 01-Aug-92 mc    Moved to CCL package. Added some documentation.
  67. 02-Aug-92 mc    Added generic functions, wrote l-str-obj-ofdi-in-range and
  68.          friends.
  69. 03-Aug-92 mc    Fixed bug in l-str-obj-ofdi-in-range that returned wrong
  70.          values for indices within an object.
  71. 10-Aug-92 mc    Defined string-from-object .
  72. 15-Aug-92 mc    Moved mouse-copy hook to "object-FDI-mouse-copy-glue.lisp" .
  73. 06-Sep-92 mc    Fixed bug in advised buffer-delete (didn't handle marks for
  74.          third arg).
  75.  
  76. |#
  77.  
  78.  
  79. (in-package "CCL")
  80.  
  81. (export '(OBJECT-FRED-DIALOG-ITEM
  82.           FONT-SPEC-STRING-OFDI
  83.           FONT-SPEC-NON-STRING-OFDI
  84.           ADD-LINK
  85.           EDIT-L-DATA
  86.           L-STR-OBJ-OFDI
  87.           L-STR-OBJ-OFDI-SELECTED
  88.           L-STR-OBJ-OFDI-IN-RANGE
  89.           STRING-FROM-OBJECT
  90.           *L-OBJECT-GIVEN*))
  91.  
  92.  
  93. ;;;================================================================
  94. ;;; Define the object-fred-dialog-item class and methods.
  95. ;;;================================================================
  96.  
  97. (defclass object-fred-dialog-item (fred-dialog-item)    ;super s/b fred-mixin?
  98.   ((l-l-obj-marks
  99.     :accessor l-l-obj-marks-ofdi
  100.     :type list
  101.     :initform ()
  102.     :documentation "A sorted list of lists used by edit-l-data and
  103. l-str-obj-ofdi. Each sublist is a list of a non-string object,
  104. its start mark, and its string representation. Add-link adds items to
  105. the list and maintains its sorted order, which is in ascending order of
  106. position.")
  107.    (font-spec-string
  108.     :accessor font-spec-string-ofdi
  109.     :type list
  110.     :initarg :font-spec-string
  111.     :initform '("Geneva" 9 :plain)
  112.     :documentation "The font spec to display strings in.")
  113.    (font-spec-non-string
  114.     :accessor font-spec-non-string-ofdi
  115.     :type list
  116.     :initarg :font-spec-string
  117.     :initform '("Geneva" 9 :plain :bold)
  118.     :documentation "The font spec to display non-string objects in.")
  119.    (f-paste-with-styles-saved
  120.     :accessor f-paste-with-styles-saved-ofdi
  121.     :initform *paste-with-styles*
  122.     :type t
  123.     :documentation "The saved value of *paste-with-styles* .")
  124.    )
  125.   (:default-initargs
  126.     :allow-returns t
  127.     :allow-tabs t
  128.     :copy-styles-p nil))
  129.  
  130.  
  131. ;;;================================================================
  132. ;;; Define support for the advised functions.
  133. ;;;================================================================
  134.  
  135. (defparameter *object-fred-dialog-item-editing* nil
  136.   "Bound to the object-fred-dialog-item within which a deletion or section
  137. is being done. Used to communicate between view-key-event-handler and
  138. view-click-event-handler, and the advised buffer-delete
  139. frec-set-sel and frec-set-sel-simple .")
  140.  
  141.  
  142. ;;; We advise buffer-delete to know, regardless of how the deletion is
  143. ;;;  initiated, what the range about to be deleted is.
  144.  
  145. (advise buffer-delete
  146.         ;; Arglist: buffer-mark start &optional end
  147.         (cond (*object-fred-dialog-item-editing*
  148.                ;; Start and end might delete part of an object.
  149.                (unless (maybe-delete-objects
  150.                         *object-fred-dialog-item-editing*
  151.                         (second arglist)
  152.                         (if (third arglist)
  153.                           (if (buffer-mark-p (third arglist))
  154.                             (buffer-position (third arglist))
  155.                             (third arglist))
  156.                           (buffer-position (first arglist))))
  157.                  (:do-it)))
  158.               (t (:do-it)))
  159.         :when :around
  160.         :name maybe-delete-objects)
  161.  
  162.  
  163.  
  164. #|
  165. (advise buffer-insert
  166.         ;; Arglist: buffer-mark string &optional position
  167.         (cond (*object-fred-dialog-item-editing*
  168.                ;; Position might be within an object.
  169.                (let ((int-position (or (third arglist)
  170.                                        (buffer-position (first arglist)))))
  171.                  (if (l-str-obj-ofdi-in-range
  172.                       *object-fred-dialog-item-editing*
  173.                       int-position int-position)
  174.                    nil                  ;(ed-beep)
  175.                    (:do-it))))
  176.               (t (:do-it)))
  177.         :when :around
  178.         :name maybe-delete-objects)
  179. |#
  180.         
  181.  
  182. #|
  183. ;;; We need advise frec-set-sel and frec-set-sel-simple to catch
  184. ;;;  programmatic changing of selections. But then we must get the
  185. ;;;  fred-mixin item from the args to call maybe-extend-selection! Don't do
  186. ;;;  for now.
  187.  
  188. (advise frec-set-sel
  189.         (when *object-fred-dialog-item-editing*
  190.           (maybe-extend-selection *object-fred-dialog-item-editing*))
  191.         :when :after
  192.         :name maybe-extend-selection)
  193.  
  194. (advise frec-set-sel-simple
  195.         (when *object-fred-dialog-item-editing*
  196.           (maybe-extend-selection *object-fred-dialog-item-editing*))
  197.         :when :after
  198.         :name maybe-extend-selection)|#
  199.  
  200.  
  201. ;;;================================================================
  202. ;;; Define window event functions.
  203. ;;;================================================================
  204.  
  205. (defmethod view-key-event-handler ((object-fred-dialog-item object-fred-dialog-item)
  206.                                     character)
  207.   (declare (ignore character)
  208.            (optimize speed))
  209.   ;;
  210.   ;; Following form catches deletions via the advised buffer-delete .
  211.   ;;
  212.   (let ((*object-fred-dialog-item-editing* object-fred-dialog-item))
  213.     (call-next-method))
  214.   ;;
  215.   ;; Following form catches selection range changes via keystrokes.
  216.   ;;
  217.   (maybe-extend-selection object-fred-dialog-item))
  218.  
  219.  
  220. (defmethod view-click-event-handler ((object-fred-dialog-item object-fred-dialog-item)
  221.                                      where)
  222.   (declare (ignore where)
  223.            (optimize speed))
  224.   ;;
  225.   (let ((*object-fred-dialog-item-editing* nil))   ;otherwise causes infinite loop
  226.     (call-next-method))
  227.   ;;
  228.   ;; Following form catches selection range changes via mouse.
  229.   ;;
  230.   (maybe-extend-selection object-fred-dialog-item))
  231.  
  232.  
  233. (defmethod view-activate-event-handler :after ((object-fred-dialog-item object-fred-dialog-item))
  234.   "Saves *paste-with-styles* and sets it to nil so that all inserted text
  235. is in font-spec-string-ofdi ."
  236.   (declare (optimize speed))
  237.   ;;
  238.   (setf (f-paste-with-styles-saved-ofdi object-fred-dialog-item) *paste-with-styles*
  239.         *paste-with-styles* nil))
  240.  
  241.  
  242. (defmethod view-deactivate-event-handler :after ((object-fred-dialog-item object-fred-dialog-item))
  243.   "Restores *paste-with-styles* ."
  244.   (declare (optimize speed))
  245.   ;;
  246.   (setf *paste-with-styles* (f-paste-with-styles-saved-ofdi object-fred-dialog-item)))
  247.  
  248.  
  249. (defmethod undo ((object-fred-dialog-item object-fred-dialog-item))
  250.   "Calls ed-beep for now. Fix (will just call usual?)."
  251.   (declare (optimize speed))
  252.   ;;
  253.   (ed-beep))
  254.  
  255.  
  256. (defmethod set-view-font ((object-fred-dialog-item object-fred-dialog-item)
  257.                           font-spec)
  258.   "Does nothing so that our font scheme isn't messed up."
  259.   (declare (optimize speed))
  260.   ;;
  261.   font-spec)
  262.  
  263.  
  264. ;;;================================================================
  265. ;;; Define support for window event functions.
  266. ;;;================================================================
  267.  
  268. ;;; Fix: Call setup-undo (see p. 363, ch. 12: Programming Fred) to handle
  269. ;;;  re-inserting and re-deleting links. The former should call add-link.
  270.  
  271. (defmethod maybe-delete-objects ((object-fred-dialog-item object-fred-dialog-item)
  272.                                  (int-index-delete-start integer)
  273.                                  (int-index-delete-end integer))
  274.   "Deletes the entry in object-fred-dialog-item's l-l-obj-marks-ofdi corresponding to
  275. the about-to-be-deleted range in object-fred-dialog-item specified by
  276. int-index-delete-start and int-index-delete-end . Should be called
  277. before the specified range is about to be deleted. Returns f-delete-done
  278. which is non-nil when maybe-delete-objects has taken care of deleting the
  279. passed range."
  280.   (declare (optimize speed))
  281.   ;;
  282.   ;; If there are selected objects in the range then delete them as part of
  283.   ;;  their text being deleted.
  284.   ;;
  285.   (let* ((buffer (fred-buffer object-fred-dialog-item))
  286.          (l-l-obj-marks-in-range
  287.           (l-l-obj-marks-in-range object-fred-dialog-item int-index-delete-start int-index-delete-end))
  288.          (l-obj-mark-in-range-first (first l-l-obj-marks-in-range))
  289.          (l-obj-mark-in-range-last (first (last l-l-obj-marks-in-range)))
  290.          ;; Following two computations depend on l-l-obj-marks-ofdi being
  291.          ;;  sorted in ascending order of position:
  292.          (int-index-first-obj-start
  293.           (and l-l-obj-marks-in-range
  294.                (multiple-value-bind (int-index-obj-start int-index-obj-end)
  295.                                     (int-index-object-bounds l-obj-mark-in-range-first)
  296.                  (declare (ignore int-index-obj-end))
  297.                  ;;
  298.                  int-index-obj-start)))
  299.          (int-index-last-obj-end
  300.           (and l-l-obj-marks-in-range
  301.                (multiple-value-bind (int-index-obj-start int-index-obj-end)
  302.                                     (int-index-object-bounds l-obj-mark-in-range-last)
  303.                  (declare (ignore int-index-obj-start))
  304.                  ;;
  305.                  int-index-obj-end)))
  306.          (int-index-delete-start-actual
  307.           (and l-l-obj-marks-in-range (min int-index-delete-start
  308.                                            int-index-first-obj-start)))
  309.          (int-index-delete-end-actual
  310.           (and l-l-obj-marks-in-range (max int-index-delete-end
  311.                                            int-index-last-obj-end)))
  312.          (f-delete-done l-l-obj-marks-in-range))
  313.     ;;
  314.     ;; Note: It may be that deleting the passed range will not delete all
  315.     ;;  of l-l-obj-marks-in-range's object text.
  316.     ;;
  317.     (when l-l-obj-marks-in-range
  318.       (let ((*object-fred-dialog-item-editing* nil))       ;otherwise causes infinite loop
  319.         (buffer-delete buffer
  320.                        int-index-delete-start-actual int-index-delete-end-actual))
  321.       (setf (l-l-obj-marks-ofdi object-fred-dialog-item)
  322.             (delete-if #'(lambda (l-obj-marks-ew)
  323.                            (member l-obj-marks-ew l-l-obj-marks-in-range))
  324.                        (l-l-obj-marks-ofdi object-fred-dialog-item))))
  325.     ;;
  326.     f-delete-done))
  327.  
  328.  
  329. (defmethod maybe-extend-selection ((object-fred-dialog-item object-fred-dialog-item))
  330.   "Extends the selection if part of it touches an object's text."
  331.   (declare (optimize speed))
  332.   ;;
  333.   (let (int-index-selection-start
  334.         int-index-selection-end)
  335.     (dolist (l-obj-marks (l-l-obj-marks-ofdi object-fred-dialog-item))
  336.       ;; We call selection-range each time because previous calls to
  337.       ;;  maybe-extend-object may have changed it.
  338.       (multiple-value-setq (int-index-selection-start int-index-selection-end)
  339.         (selection-range object-fred-dialog-item))
  340.       (maybe-extend-object object-fred-dialog-item l-obj-marks
  341.                              int-index-selection-start
  342.                              int-index-selection-end))))
  343.  
  344.  
  345. (defmethod maybe-extend-object ((object-fred-dialog-item object-fred-dialog-item)
  346.                                  (l-obj-marks list)
  347.                                  (int-index-selection-start integer)
  348.                                  (int-index-selection-end integer))
  349.   "Extends if necessary the selection corresponding to the object in
  350. l-obj-marks."
  351.   (declare (optimize speed))
  352.   ;;
  353.   (multiple-value-bind (int-index-obj-start int-index-obj-end)
  354.                        (int-index-object-bounds l-obj-marks)
  355.     (let* ((f-extend-start
  356.             (and (< int-index-obj-start int-index-selection-start)
  357.                  (< int-index-selection-start int-index-obj-end)))
  358.            (f-extend-end
  359.             (and (< int-index-obj-start int-index-selection-end)
  360.                  (< int-index-selection-end int-index-obj-end))))
  361.       (set-selection-range
  362.        object-fred-dialog-item
  363.        (if f-extend-start int-index-obj-start int-index-selection-start)
  364.        (if f-extend-end int-index-obj-end int-index-selection-end))
  365.       (fred-update object-fred-dialog-item))))
  366.  
  367.  
  368. ;;;================================================================
  369. ;;; Define functions that return information about objects, whether they're
  370. ;;;  selected, and their bounds.
  371. ;;;================================================================
  372.  
  373. (defmethod int-index-object-bounds ((l-obj-marks list))
  374.   "Returns two values, int-index-obj-start (inclusive) and
  375. int-index-obj-end (exclusive), corresonding to the object in
  376. l-obj-marks."
  377.   (declare (optimize speed))
  378.   ;;
  379.   (let ((int-index-obj-start (buffer-position (second l-obj-marks))))
  380.     (values int-index-obj-start
  381.             (+ int-index-obj-start (length (third l-obj-marks))))))
  382.  
  383.  
  384. (defmethod l-l-obj-marks-in-range ((object-fred-dialog-item object-fred-dialog-item)
  385.                                    (int-index-range-start integer)
  386.                                    (int-index-range-end integer))
  387.   "Returns a list of the objects in object-fred-dialog-item whose boundaries are
  388. either includeded by or contain the range specified by
  389. int-index-range-start and int-index-range-end. The returned list in the
  390. same format as object-fred-dialog-item's l-l-obj-marks slot."
  391.   (declare (optimize speed))
  392.   ;;
  393.   (remove-if-not
  394.    #'(lambda (l-obj-marks-ew)
  395.        (multiple-value-bind (int-index-obj-start int-index-obj-end)
  396.                             (int-index-object-bounds l-obj-marks-ew)
  397.          (or (< int-index-obj-start int-index-range-start int-index-obj-end)
  398.              (< int-index-obj-start int-index-range-end int-index-obj-end)
  399.              (and (<= int-index-range-start
  400.                       int-index-obj-start)
  401.                   (<= int-index-obj-end
  402.                       int-index-range-end)))))
  403.    (l-l-obj-marks-ofdi object-fred-dialog-item)))
  404.  
  405.  
  406. (defmethod l-l-obj-marks-selected ((object-fred-dialog-item object-fred-dialog-item))
  407.   "Returns a list of the objects currently selected in object-fred-dialog-item, in the
  408. same format as object-fred-dialog-item's l-l-obj-marks slot."
  409.   (declare (optimize speed))
  410.   ;;
  411.   (multiple-value-bind (int-index-selection-start int-index-selection-end)
  412.                        (selection-range object-fred-dialog-item)
  413.     (l-l-obj-marks-in-range object-fred-dialog-item
  414.                             int-index-selection-start int-index-selection-end)))
  415.  
  416.  
  417. ;;;================================================================
  418. ;;; Define the top-level methods for using object-fred-dialog-items.
  419. ;;;================================================================
  420.  
  421. (defgeneric add-link (object-fred-dialog-item object int-index)
  422.   (:documentation "Adds a link to object in object-fred-dialog-item at
  423. int-index."))
  424.  
  425.  
  426. (defmethod add-link ((object-fred-dialog-item object-fred-dialog-item)
  427.                      (object t)
  428.                      (int-index integer))
  429.   (declare (optimize speed))
  430.   ;;
  431.   (when (stringp object)
  432.     (error "~S is a string and should be any non-string object." object))
  433.   ;;
  434.   (let* ((buffer (fred-buffer object-fred-dialog-item))
  435.          int-index-start
  436.          str-data)
  437.     ;;
  438.     ;; If object-fred-dialog-item has a selection delete it.
  439.     ;;
  440.     (multiple-value-bind (int-index-selection-start int-index-selection-end)
  441.                          (selection-range object-fred-dialog-item)
  442.       (unless (= int-index-selection-start int-index-selection-end)
  443.         (maybe-delete-objects object-fred-dialog-item
  444.                               int-index-selection-start int-index-selection-end)
  445.         (buffer-delete buffer int-index-selection-start int-index-selection-end)))
  446.     ;;
  447.     ;; Insert a new link.
  448.     ;;
  449.     (setf int-index-start (buffer-position buffer))
  450.     (buffer-set-font-spec buffer (font-spec-non-string-ofdi object-fred-dialog-item))
  451.     (setf str-data (string-from-object object object-fred-dialog-item))
  452.     (buffer-insert buffer str-data)
  453.     ;; Make the mark *after* the insert so that it doesn't move on us.
  454.     (push (list object (make-mark buffer int-index-start) str-data)
  455.           (l-l-obj-marks-ofdi object-fred-dialog-item))
  456.     (sort-l-l-obj-marks-ofdi object-fred-dialog-item)
  457.     (buffer-set-font-spec buffer (font-spec-string-ofdi object-fred-dialog-item))
  458.     (fred-update object-fred-dialog-item)))
  459.  
  460.  
  461. (defgeneric edit-l-data (l-data object-fred-dialog-item)
  462.   (:documentation "Starts editing in object-fred-dialog-item the
  463. information in l-data. L-data is a list of strings and non-string
  464. objects. The user can edit the string portion of l-data but can only
  465. select and delete non-string objects. Calling "))
  466.  
  467.  
  468. (defmethod edit-l-data ((l-data list) (object-fred-dialog-item object-fred-dialog-item))
  469.   (declare (optimize speed))
  470.   ;;
  471.   ;; Insert each item on l-data into buffer. If it's a string then insert
  472.   ;;  it using (font-spec-string-ofdi object-fred-dialog-item). Otherwise insert it using
  473.   ;;  (font-spec-non-string-ofdi object-fred-dialog-item), add a new entry for the object in
  474.   ;;  (l-l-obj-marks-ofdi object-fred-dialog-item) with new start and end marks.
  475.   ;;
  476.   (let ((buffer (fred-buffer object-fred-dialog-item)))
  477.     (setf (l-l-obj-marks-ofdi object-fred-dialog-item) ())
  478.     (buffer-delete buffer 0 (buffer-size buffer))       ;delete all buffer's text
  479.     (dolist (data l-data)
  480.       (typecase data
  481.         (string
  482.          (buffer-set-font-spec buffer (font-spec-string-ofdi object-fred-dialog-item))
  483.          (buffer-insert buffer data))
  484.         (t
  485.          (add-link object-fred-dialog-item data (buffer-position buffer)))))
  486.     ;;
  487.     ;; Correct buffer's insertion font so typing will be correct, then
  488.     ;;  show the updated buffer.
  489.     ;;
  490.     (buffer-set-font-spec buffer (font-spec-string-ofdi object-fred-dialog-item))
  491.     (fred-update object-fred-dialog-item)))
  492.  
  493.  
  494. (defgeneric l-str-obj-ofdi (object-fred-dialog-item)
  495.   (:documentation "Returns l-str-obj, which contains in order all the
  496. strings and objects in object-fred-dialog-item."))
  497.  
  498.  
  499. (defmethod l-str-obj-ofdi ((object-fred-dialog-item object-fred-dialog-item))
  500.   (declare (optimize speed))
  501.   ;;
  502.   (let ((buffer (fred-buffer object-fred-dialog-item)))
  503.     (l-str-obj-ofdi-in-range object-fred-dialog-item
  504.                              0 (buffer-size buffer))))
  505.  
  506.  
  507. (defgeneric l-str-obj-ofdi-selected (object-fred-dialog-item)
  508.   (:documentation "Returns l-str-obj, which contains in order all the
  509. strings and objects in object-fred-dialog-item's current selection
  510. range."))
  511.  
  512.  
  513. (defmethod l-str-obj-ofdi-selected ((object-fred-dialog-item object-fred-dialog-item))
  514.   (declare (optimize speed))
  515.   ;;
  516.   (multiple-value-bind (int-index-selection-start int-index-selection-end)
  517.                        (selection-range object-fred-dialog-item)
  518.     (l-str-obj-ofdi-in-range object-fred-dialog-item
  519.                              int-index-selection-start int-index-selection-end)))
  520.  
  521.  
  522. (defgeneric l-str-obj-ofdi-in-range (object-fred-dialog-item
  523.                                     int-index-start
  524.                                     int-index-end)
  525.   (:documentation "Returns l-str-obj, which contains in order all the
  526. strings and objects in object-fred-dialog-item's between int-index-start
  527.  (inclusive) and int-index-end (exclusive)."))
  528.  
  529.  
  530. (defmethod l-str-obj-ofdi-in-range ((object-fred-dialog-item object-fred-dialog-item)
  531.                                    (int-index-start integer)
  532.                                    (int-index-end integer))
  533.   (declare (optimize speed))
  534.   ;;
  535.   (let ((l-str-obj ())
  536.         (int-index-prev-str int-index-start)
  537.         (buffer (fred-buffer object-fred-dialog-item))
  538.         int-index-obj-start int-index-obj-end)
  539.     ;;
  540.     ;; For each object, save the string preceding it onto l-str-obj then
  541.     ;;  save the object itself. The string's start is in
  542.     ;;  int-index-prev-str. Depends on l-l-obj-marks-ofdi being sorted in
  543.     ;;  ascending order of position.
  544.     ;;
  545.     (dolist (l-obj-marks (l-l-obj-marks-in-range object-fred-dialog-item
  546.                                                  int-index-start
  547.                                                  int-index-end))
  548.       (multiple-value-setq (int-index-obj-start int-index-obj-end)
  549.         (int-index-object-bounds l-obj-marks))
  550.       (when (and (/= int-index-prev-str int-index-obj-start)
  551.                  (not (<= int-index-obj-start int-index-prev-str int-index-obj-end)))
  552.         ;; We have a preceding string so save it.
  553.         (push (buffer-substring buffer int-index-prev-str int-index-obj-start)
  554.               l-str-obj))
  555.       (push (first l-obj-marks) l-str-obj)
  556.       (setf int-index-prev-str int-index-obj-end))
  557.     ;;
  558.     ;; Add the final string if there is one and return the result.
  559.     ;;
  560.     (when (or (null int-index-obj-end)
  561.               (< int-index-obj-end int-index-end))
  562.       (push (buffer-substring buffer int-index-prev-str int-index-end)
  563.             l-str-obj))
  564.     (reverse l-str-obj)))
  565.  
  566.  
  567. (defgeneric string-from-object (object object-fred-dialog-item)
  568.   (:documentation "Returns a textual representation of object as a string.
  569. T's version (the default for all objects), returns the object's ~S
  570. format string."))
  571.  
  572.  
  573. (defmethod string-from-object ((object t)
  574.                                (object-fred-dialog-item object-fred-dialog-item))
  575.   (declare (optimize speed)
  576.            (ignore object-fred-dialog-item))
  577.   ;;
  578.   (format nil "~S" object))
  579.  
  580.  
  581. ;;;================================================================
  582. ;;; Define remaining support functions.
  583. ;;;================================================================
  584.  
  585. (defmethod sort-l-l-obj-marks-ofdi ((object-fred-dialog-item object-fred-dialog-item))
  586.   "Sorts l-l-obj-marks-ofdi in ascending order of position."
  587.   (declare (optimize speed))
  588.   ;;
  589.   (setf (l-l-obj-marks-ofdi object-fred-dialog-item)
  590.         (sort (l-l-obj-marks-ofdi object-fred-dialog-item)
  591.               #'<
  592.               :key #'(lambda (l-obj-mark)
  593.                        (buffer-position (second l-obj-mark))))))
  594.  
  595.  
  596. (provide "OBJECT-FRED-DIALOG-ITEM")
  597.  
  598.  
  599. #|
  600.  
  601. ;;; See "object-FDI-mouse-copy-glue.lisp" for another example.
  602.  
  603. ;;; Define testing code.
  604.  
  605. (defclass describing-ofdi (object-fred-dialog-item)
  606.   ()
  607.   (:documentation "A subclass of object-fred-dialog-item that describes the
  608. current selection."))
  609.  
  610.  
  611. (defmethod view-click-event-handler :after ((describing-ofdi describing-ofdi)
  612.                                             where)
  613.   (declare (ignore where)
  614.            (optimize speed))
  615.   ;;
  616.   (when (double-click-p)
  617.     (let ((l-str-obj-ofdi-selected (l-str-obj-ofdi-selected describing-ofdi)))
  618.       (when l-str-obj-ofdi-selected
  619.         (dolist (l-str-obj l-str-obj-ofdi-selected)
  620.           (format t "~&~A:~20T~S." (type-of l-str-obj) l-str-obj))))))
  621.  
  622.  
  623. (defclass temp ()()
  624.   (:documentation "A class of objects that prints with a #\), so I can test
  625. killing into an object."))
  626.  
  627. (defmethod print-object ((object temp) stream)
  628.   (princ "<Bad ) >" stream))
  629.  
  630.  
  631. (defparameter *l-data-test* (list "Dear "
  632.                                   '|Mary|
  633.                                   (format nil ":~%On ")
  634.                                   23
  635.                                   " we dis(cussed "
  636.                                   (make-instance 'temp)
  637.                                   ;(make-instance 'menu-item)
  638.                                   (format nil "~%which we both liked."))
  639.   "The test data used by test.")
  640.  
  641.  
  642. (defparameter *window-test* nil
  643.   "The edit window used by test.")
  644.  
  645. (defparameter *ofdi-test* nil
  646.   "The object-fred-dialog-item used by test.")
  647.  
  648.  
  649. (defun test-ofdi ()
  650.   (when (or (null *window-test*)
  651.             (null (wptr *window-test*)))
  652.     (setf *ofdi-test* (make-instance 'describing-ofdi
  653.                            :view-position #@(3 3)
  654.                            :view-size #@(300 200))
  655.           *window-test* (make-instance 'window :window-title "Test OFDI"
  656.                                        :window-type :document
  657.                                        :view-size #@(302 202)
  658.                                        :view-subviews (list *ofdi-test*))))
  659.   (edit-l-data *l-data-test* *ofdi-test*))
  660.  
  661.  
  662. (defun f-editing-loop-ok ()
  663.   "Returns non-nil if the result of running test then calling
  664. l-str-obj-ofdi changes *l-data-test* ."
  665.   ;;
  666.   (let ((l-data-test-initial *l-data-test*))
  667.     (test)
  668.     (equalp l-data-test-initial
  669.             (l-str-obj-ofdi *ofdi-test*))))
  670. |#